C **************************************************************
C
      SUBROUTINE USR_TRNF_KINE(NKINE,TMP,ATMK,EFSTS,STSME,EFSTR,
     $                  FR,DFR,TIC,TICN,DTX,NEWTR,VFM,DTMPE,NUSRVE,
     $                  USRVE,IELE)     
C **************************************************************
C   THIS IS USER'S TRANSFORMATION KINETICS ROUTINE (OLD USRRAT)
C   INPUT:  NKINE   - KIND NUMBER OF TRANSFORMATION KINETICS EQUATIONS
C           TMP     - TEMPERATURE AT THE INTERMIDIATE TIME OF SUB-STEP
C           ATMK    - MEAN CARBON CONTENT OF ELEMENT
C           EFSTS   - EFFECTIVE STRESS
C           STSME   - MEAN STRESS
C           EFSTR   - EFFECTIVE PLASTIC STRAIN
C           FR      - CURRENT VOLUME FRACTION OF THE CHILD PHASE
C                      (Normalized for additive rule)
C           VFM     - CURRENT VOLUME FRACTION OF THE PARENT PHASE
C                      (Always 1.0 for additive rule)
C           TIC     - NORMALIZED INCUBATION TIME AND 
C           DTX     - TIME INCREMENT OF SUB-STEP
C           NUSRVE - NUMBER OF USER VARIABLES
C           USRVE - USER VARIABLE ARRAY
C           IELE - CURRENT ELEMENT NUMBER (GLOBAL)    
C
C   OUTPUT: 
C           DFR     - CHILD PHASE VOLUME FRACTION CHANGE DURING THE SUB-STEP
C           TICN    - updated incubation time
C           NEWTR   - IF NEW TRANSFORMATION HAS STARTED, SET TO 1 (Obsolete for non-additive rule)
C           NUSRVE - NUMBER OF USER VARIABLES
C           USRVE - USER VARIABLE ARRAY
C      
  
C **********************************************************************
C
      IMPLICIT REAL*8 (A-H,O-Z), INTEGER*4 (I-N)

	  DIMENSION USRVE(NUSRVE)
      
C
C  EXAMPLES OF USER SUPPLIED SUBROUTINES
C
      GO TO (510,520,530,540,550,560,570,580,590,600),NKINE
C
  510 CONTINUE
         CALL RATEEX1(TMP,ATMK,STSME,FR,DFR,TIC,TICN,DTX,NEWTR,
     $ USRVE,NUSRVE)
      RETURN
  520 CONTINUE
         CALL RATEEX2(TMP,ATMK,EFSTS,STSME,FR,DFR,TIC,TICN,NEWTR,
     $ USRVE,NUSRVE)		 
      RETURN
  530 CONTINUE
      RETURN
  540 CONTINUE
      RETURN
  550 CONTINUE
      RETURN
  560 CONTINUE
      RETURN
  570 CONTINUE
      RETURN
  580 CONTINUE
      RETURN
  590 CONTINUE
      RETURN
  600 CONTINUE
      RETURN
      END
C **********************************************************************
      SUBROUTINE RATEEX1(TMP,ATMK,STSME,FR,DFR,TIC,TICN,DTX,NEWTR,
     $ USRVE,NUSRVE)    
C **********************************************************************
C     This is exmple #1 for user's phase transformation subroutine
C **********************************************************************
C
      IMPLICIT REAL*8 (A-H,O-Z), INTEGER*4 (I-N)
      
      DIMENSION USRVE(NUSRVE)      
     
C
          

      AB1=0.04325
      AB2=380.
      AB3=145.
      AB4=6.8
      AB5=720.
      AB6=195.
      AB7=8.2
      AB8=0.0039768
      AB9=0.
      AB10=0.
      AB11=4.
      XS=0.001
      THIGH=AB5
      TLOW =AB2
      IF (TMP.GT.THIGH.OR.TMP.LT.TLOW) THEN
         GO TO 1000
      END IF
      Func_T=AB1*((TMP-AB2)/AB3)**AB4
     $     *((AB5-TMP)/AB6)**AB7
      Func_S = exp(AB8*STSME)
      Func_C = exp(AB9*(ATMK-AB10))

      xb = Func_T*Func_S*Func_C
      xn = AB11
      IF(TIC.LT.1.0) THEN
         CALL INCUBT(DTX,XB,XN,TIC,TICN,XS)
         GO TO 1000
      END IF
      F1=1.0D0-FR
      IF (F1.LT.1.0D-7) THEN
         DFR = 0.0D0
         GO TO 1000
      ENDIF
      X=1.0D0/xn
C
      if (FR.LT.XS) Then
         FR = FR + XS
         F1 = 1.0D0-FR
         X = 1.0D0/XN
         DFDT = XN*XB**X*(1.0D0-FR)*(-LOG(F1))**(1.0D0-X)
         IF(DFDT.LT.0.0D0) DFDT=0.0D0
         DFR = DFDT*DTX
         DFR = DFR + XS
      ELSE
         X=1.0D0/XN
         DFDT=XN*XB**X*(1.0D0-FR)*(-LOG(F1))**(1.0D0-X)
         IF(DFDT.LT.0.0D0) DFDT=0.0D0
         DFR=DFDT*DTX
      END IF
C
 1000 CONTINUE
      IF (TIC.LT.1.0.AND.(TICN.GE.1.0.AND.TICN.LT.2.0)) THEN
         NEWTR=1
      END IF
C
C
      RETURN
      END
C **********************************************************************
      SUBROUTINE INCUBT(DTX,XB,XN,TIC,TICN,XS)
C **********************************************************************
      IMPLICIT REAL*8 (A-H,O-Z), INTEGER*4 (I-N)
C
C     calculates the incubation time for any diffusion type 
C     transformation for a particular temprature. XB and XN are the
C     interpolated b and n values for the given temprature.
C
      Ti = LOG(1.0D0/(1.0D0-XS))
      Ti = (Ti/XB)**(1.0D0/XN)
      TICN = TIC + DTX/TI
C
      IF (TICN .GT. 1.0) TICN = 1.0
C
      RETURN
      END
C **********************************************************************
      SUBROUTINE RATEEX2(TMP,ATMK,EFSTS,STSME,FR,DFR,TIC,TICN,NEWTR,
     $ USRVE,NUSRVE)
C **********************************************************************
C     This is exmple #2 for user's phase transformation subroutine
C **********************************************************************

      IMPLICIT REAL*8 (A-H,O-Z), INTEGER*4 (I-N)

      DIMENSION USRVE(NUSRVE)      
       
      psi1=0.016
      psi2=0.
      psi31=-0.0012237
      psi32=-0.0010303
      psi4=-5.18
      C0=0.45
      ZIM=1-exp(psi1*TMP+psi2*(ATMK-C0)+psi31*STSME+psi32*EFSTS+
     $     psi4)
      IF (ZIM.GT.1.0.OR.ZIM.LE.0.0.OR.ZIM.LT.FR) THEN 
         RETURN
      END IF
      DFR=ZIM-FR

      RETURN
      END
C---+----+----+----+----+----+----+----+----+----+----+----+----+----+--
